home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Panorama / Panorama - Disk 28C (1988-04-27)(Pacific North-West Amigas Club)[WB].zip / Panorama - Disk 28C (1988-04-27)(Pacific North-West Amigas Club)[WB].adf / ModulaII / Etchm2 / EtchGlobal.Mod < prev    next >
Text File  |  1987-12-24  |  2KB  |  68 lines
  1. IMPLEMENTATION MODULE EtchGlobal;
  2. (*********************************************************)
  3. (*       Some low level routines for EtchAsketch         *)
  4. (*                                                       *)
  5. (*        Written for the Benchmark M2 compiler.         *)
  6. (*                                                       *)
  7. (* Steve Faiwiszewski                     December 1987  *)
  8. (*********************************************************)
  9.  
  10. FROM Memory    IMPORT MemReqSet, MemPublic, MemChip,
  11.                       MemClear;
  12. FROM Intuition IMPORT FreeRemember, AllocRemember;
  13. FROM TermInOut IMPORT WriteString, WriteLn;
  14. FROM RunTimeErrors 
  15.                IMPORT InstallErrorHandler,
  16.                       RemoveErrorHandler;
  17. FROM SYSTEM    IMPORT ADDRESS;
  18.  
  19. VAR
  20.     CurrentTermProc : CARDINAL;
  21.     TermProcs       : ARRAY [0..50] OF PROC;
  22.  
  23. PROCEDURE TheEnd;
  24. BEGIN
  25.     WriteString('Releasing all allocations.'); WriteLn;
  26.     FreeRemember(RKey, TRUE);
  27.     RemoveErrorHandler;
  28.     HALT
  29. END TheEnd;
  30.  
  31. PROCEDURE Allocate(VAR ptr : ADDRESS; size : LONGCARD);
  32. BEGIN
  33.     ptr := AllocRemember(RKey, size,
  34.                          MemReqSet{MemClear,MemPublic});
  35. END Allocate;
  36.  
  37. PROCEDURE ChipAllocate(VAR ptr : ADDRESS; size : LONGCARD);
  38. BEGIN
  39.     ptr := AllocRemember(RKey, size,
  40.                     MemReqSet{MemClear,MemPublic,MemChip});
  41. END ChipAllocate;
  42.  
  43. PROCEDURE AddTerminationProc(t : PROC);
  44. (* Insert procedure t into the array of terminating *)
  45. (* procedures (which are called upon graceful exit. *)
  46. BEGIN
  47.     TermProcs[CurrentTermProc] := t;
  48.     INC(CurrentTermProc)
  49. END AddTerminationProc;
  50.  
  51. PROCEDURE ExitGracefully;
  52. (* Call all the designated terminating procedures. *)
  53. VAR
  54.     i : CARDINAL;
  55. BEGIN
  56.     FOR i := (CurrentTermProc-1) TO 0 BY -1 DO
  57.         TermProcs[i]
  58.     END
  59. END ExitGracefully;
  60.  
  61. BEGIN
  62.     RKey := NIL;
  63.     CurrentTermProc := 0;
  64.     AddTerminationProc(TheEnd);
  65. (* The error handler is installed just in case we need it. *)
  66.     InstallErrorHandler;
  67. END EtchGlobal.
  68.